home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 47.7z / BS1 part 47 / HiSoft BASIC v1.04 (1989)(HiSoft)(Disk 2 of 2)[h Band].7z / HiSoft BASIC v1.04 (1989)(HiSoft)(Disk 2 of 2)[h Band].adf / Data / Datamanager.BAS < prev    next >
Encoding:
BASIC Source File  |  1988-12-02  |  10.9 KB  |  387 lines
  1. Setup:
  2.   PALETTE 0,0,.1,.4
  3.   PALETTE 2,0,1,0
  4.   
  5. Begin:
  6.   CLS : LOCATE 1,1 : PRINT  "Select"
  7.   LOCATE 1,25 : COLOR 3,0 : PRINT "Filename:"; : COLOR 1,0
  8.   IF Altname$<>"" THEN PRINT Altname$ ELSE PRINT "(no file)"
  9.   PRINT
  10.   COLOR 0,3 : PRINT SPACE$(21)"AmigaBASIC DataBase"SPACE$(21)
  11.   LOCATE 5,22 : COLOR 3,0
  12.   PRINT "Please Choose:"
  13.   LOCATE 7,22
  14.   COLOR 0,1 :PRINT " 1 "; : COLOR 1,0 : PRINT " Create File"
  15.   LOCATE 9,22
  16.   COLOR 0,1 :PRINT " 2 "; : COLOR 1,0 : PRINT " Enter data"
  17.   LOCATE 11,22
  18.   COLOR 0,1 :PRINT " 3 "; : COLOR 1,0 : PRINT " Read file"
  19.   LOCATE 13,22
  20.   COLOR 0,1 :PRINT " 4 "; : COLOR 1,0 : PRINT " Search file"
  21.   LOCATE 15,22
  22.   COLOR 0,1 :PRINT " 5 "; : COLOR 1,0 : PRINT " End"
  23. MenuSelect:
  24.   LOCATE 18,1 : PRINT SPACE$(60)
  25.   LOCATE 18,22 :  COLOR 3,0 : PRINT  "Enter number:";
  26.   COLOR 1,0 :  LINE INPUT number$
  27.   number$=LEFT$(number$,1)
  28.   IF number$<"1" OR number$>"5" THEN MenuSelect
  29.   IF number$="1" THEN CreateFile
  30.   IF number$="2" THEN EnterData
  31.   IF number$="3" THEN DataSearch=0 : GOTO ReadData
  32.   IF number$="4" THEN DataSearch=1 : GOTO ReadData
  33.   PRINT  "Program ended."
  34. END
  35.  
  36. CreateFile:
  37.   CLS : LOCATE 1,1 : COLOR 1,0 : PRINT  "Create File"
  38.   LOCATE 1,25 : COLOR 3,0 : PRINT "Filename:";
  39.   COLOR 1,0 : PRINT "(no file)" 
  40.   COLOR 3,0 : LOCATE 3,1
  41.   PRINT "Enter field name and field length."
  42.   COLOR 1,0
  43.   FOR x=0 TO 9
  44.     Fieldname$="" : Length(x)=0
  45.   NEXT x
  46.   LOCATE 4,1 : PRINT "Name" : LOCATE 4,26 : PRINT "Length (<40)"
  47.   FOR x=0 TO 9
  48.     NoOfFields=x
  49.     LOCATE x+6,1 : LINE INPUT Fieldname$(x)
  50.     IF Fieldname$(x)="" THEN x=10 : NoOfFields=NoOfFields-1
  51.     Fieldname$(x)=LEFT$(Fieldname$(x),25)
  52.     LOCATE x+6,26 : PRINT SPACE$(40);
  53.     LOCATE x+6,26 : LINE INPUT Length$
  54.     IF Length$="" OR ABS(VAL(Length$))>40 THEN Length$="40"
  55.     Length(x)=INT(ABS(VAL(Length$)))
  56.     IF Length(x)=0 THEN Length(x)=40
  57.   NEXT x
  58.  
  59. Corrections:
  60.   GOSUB EntryOK
  61.   IF Corr=0 THEN OpenFile
  62.   IF Corr=1 THEN ErrorCorrection
  63. GOTO Corrections
  64.  
  65. ErrorCorrection:
  66.   FOR x=0 TO NoOfFields
  67.     LOCATE x+6,1 : PRINT SPACE$(60)
  68.     LOCATE x+6,25 : PRINT  Length(x)
  69.     LOCATE x+6,1 : PRINT  Fieldname$(x)
  70.   NEXT x
  71.   FOR x=0 TO NoOfFields
  72.     LOCATE x+6,1 : LINE INPUT Fieldname$
  73.     IF Fieldname$<>"" THEN Fieldname$(x)=LEFT$(Fieldname$,25)
  74.     LOCATE x+6,26 : LINE INPUT Length$
  75.     IF ABS(VAL(Length$))>40 THEN Length$="40"
  76.     IF Length$<>"" THEN Length(x)=INT(ABS(VAL(Length$)))
  77.     IF Length(x)=0 THEN Length(x)=40
  78.   NEXT x
  79.   GOTO Corrections
  80.  
  81. OpenFile:
  82.   LOCATE 19,1 : PRINT  SPACE$(60);
  83.   LOCATE 19,1 : COLOR 3,0 : PRINT  "Enter Filename:";
  84.   COLOR 1,0 : LINE INPUT Nam$
  85.   RecordLength=0
  86.   FOR x=0 TO NoOfFields
  87.     RecordLength=RecordLength+Length(x)
  88.   NEXT x
  89.   IF Nam$="" OR RecordLength=0 THEN BEEP : GOTO Begin
  90.   OPEN "R",#1,Nam$,RecordLength
  91.     FIELD #1,Length(0) AS Dat$(0),Length(1) AS Dat$(1),Length(2) AS Dat$(2),Length(3) AS Dat$(3),Length(4) AS Dat$(4),Length(5) AS Dat$(5),Length(6) AS Dat$(6),Length(7) AS Dat$(7),Length(8) AS Dat$(8),Length(9) AS Dat$(9)
  92.     FOR x=1 TO NoOfFields
  93.       LSET Dat$(x)=" " 
  94.     NEXT x
  95.   CLOSE 1
  96.   OPEN Nam$+".Flds" FOR OUTPUT AS 2
  97.     PRINT #2,NoOfFields
  98.     PRINT #2,RecordLength
  99.     PRINT #2,0
  100.     FOR x=0 TO NoOfFields
  101.       WRITE #2,Fieldname$(x)
  102.       PRINT #2,Length(x)
  103.     NEXT x
  104.   CLOSE 2
  105.   Altname$=Nam$
  106. GOTO Begin
  107.  
  108. EnterData:
  109.   CLS : LOCATE 1,1 : PRINT "Enter data"
  110.  
  111.   IF Nam$="" THEN
  112.     LOCATE 3,1 : COLOR 3,0 : PRINT "Enter Filename:"
  113.     COLOR 1,0 : LINE INPUT Nam$
  114.     IF Nam$="=" OR Nam$="*" THEN Nam$=Altname$
  115.     IF Nam$="" THEN Begin
  116.     Altname$=Nam$
  117.   END IF
  118.   GOSUB FieldFileExistYN
  119.   IF FileExist=0 THEN
  120.     COLOR 3,0 : PRINT 
  121.     PRINT "Press any key."
  122.     WHILE INKEY$="" : WEND : COLOR 1,0
  123.     GOTO Begin
  124.   END IF
  125.   GOSUB ReadFileField
  126.   RecordNumber=NoOfRecords+1
  127.   
  128.   OPEN "R",#1,Nam$,RecordLength  
  129.       FIELD #1,Length(0) AS Dat$(0),Length(1) AS Dat$(1),Length(2) AS Dat$(2),Length(3) AS Dat$(3),Length(4) AS Dat$(4),Length(5) AS Dat$(5),Length(6) AS Dat$(6),Length(7) AS Dat$(7),Length(8) AS Dat$(8),Length(9) AS Dat$(9)
  130.  
  131. InputLoop:
  132.       CLS : LOCATE 1,1 : COLOR 1,0 : PRINT "Enter new data"
  133.       LOCATE 1,25 : COLOR 3,0 : PRINT "File:";
  134.       COLOR 1,0 : PRINT  Nam$
  135.  
  136.       Inpt=0
  137.       LOCATE 1,50 : PRINT "Record:";RecordNumber
  138.       PRINT : COLOR 3,0
  139.       PRINT  "Enter new data:" : COLOR 1,0
  140.     FOR x=0 TO NoOfFields
  141.       LOCATE 5+x,1 : COLOR 2,0 : PRINT Fieldname$(x)": "
  142.     NEXT x : COLOR 1,0
  143.     FOR x=0 TO NoOfFields
  144.       LOCATE 5+x,LEN(Fieldname$(x))+3
  145.       LINE INPUT Entry$
  146.       IF Entry$<>"" THEN Inpt=1
  147.       Entry$(x)=LEFT$(Entry$,Length(x))
  148.       LSET Dat$(x) = Entry$(x)
  149.     NEXT x
  150.    Corrections2:
  151.     GOSUB EntryOK
  152.     IF Corr=0 THEN WriteRecord
  153.     IF Corr=1 THEN EnterCorrection
  154.   GOTO Corrections2
  155.  
  156.   EnterCorrection:
  157.     CLS : LOCATE 1,1 : COLOR 1,0 : 
  158. PRINT  "Add Data"
  159.     LOCATE 1,25 : COLOR 3,0 : PRINT "File:";
  160.     COLOR 1,0 : PRINT  Nam$
  161.  
  162.       LOCATE 1,50 : PRINT "Record:";RecordNumber
  163.       PRINT : PRINT 
  164.     FOR x=0 TO NoOfFields
  165.       LOCATE 5+x,1 : COLOR 2,0 : PRINT Fieldname$(x)": ";
  166.       COLOR 1,0 : PRINT Entry$(x)
  167.   
  168.     NEXT x
  169.     FOR x=0 TO NoOfFields
  170.       LOCATE 5+x,LEN(Fieldname$(x))+2
  171.       LINE INPUT Entry$
  172.       IF Entry$<>"" THEN
  173.         Inpt=1
  174.         Entry$(x)=LEFT$(Entry$,Length(x))
  175.         LSET Dat$(x) = Entry$(x)
  176.       END IF
  177.     NEXT x
  178.     GOTO Corrections2
  179.     
  180. WriteRecord:
  181.   IF Inpt=1 THEN
  182.     PUT #1,RecordNumber
  183.     IF DataFlag=1 THEN DataFlag=0 : GOTO ReadLoop
  184.     RecordNumber=RecordNumber+1
  185.   END IF
  186.   IF DataFlag=1 THEN DataFlag=0 : GOTO ReadLoop
  187. NextYN:
  188.   LOCATE 19,1 : PRINT SPACE$(60) : COLOR 3,0
  189.   LOCATE 19,1 : PRINT "Next Record (Y/N)";
  190.   COLOR 1,0 : LINE INPUT a$
  191.   IF UCASE$(a$)="Y" OR a$="" THEN InputLoop
  192.   IF UCASE$(a$)="N" THEN CloseFile
  193. GOTO NextYN
  194.  
  195. CloseFile:
  196.   CLOSE 1
  197.   OPEN Nam$+".Flds" FOR OUTPUT AS 2
  198.     PRINT #2,NoOfFields
  199.     PRINT #2,RecordLength
  200.     PRINT #2,RecordNumber-1
  201.     FOR x=0 TO NoOfFields
  202.       WRITE #2,Fieldname$(x)
  203.       PRINT #2,Length(x)
  204.     NEXT x
  205.   CLOSE 2
  206.   Nam$=""
  207. GOTO Begin
  208.  
  209. ReadData:
  210.     CLS : LOCATE 1,1 : PRINT "Read Data"
  211.     IF DataSearch=1 THEN LOCATE 1,1 : PRINT "Search Data"
  212.     LOCATE 3,1 : COLOR 3,0 : PRINT "Enter filename:"
  213.     COLOR 1,0 : LINE INPUT Nam$
  214.     IF Nam$="=" OR Nam$="*" THEN Nam$=Altname$
  215.     IF Nam$="" THEN Begin
  216.     Altname$=Nam$
  217.  
  218.     GOSUB FieldFileExistYN
  219.     IF FileExist=0 THEN
  220.       PRINT : COLOR 3,0
  221.       PRINT "Press any key."
  222.       COLOR 1,0
  223.       WHILE INKEY$="" : WEND
  224.       GOTO Begin
  225.     END IF
  226.     GOSUB ReadFileField
  227.     IF NoOfRecords=0 THEN
  228.       PRINT : BEEP
  229.       COLOR 1,0
  230.       PRINT "No records in file!"
  231.       PRINT : COLOR 3,0
  232.       PRINT "Press any key."
  233.       COLOR 1,0
  234.       WHILE INKEY$="" : WEND
  235.       GOTO Begin
  236.     END IF
  237.   IF DataSearch=1 THEN GOSUB SearchData
  238.   OPEN "R",#1,Nam$,RecordLength  
  239.       FIELD #1,Length(0) AS Dat$(0),Length(1) AS Dat$(1),Length(2) AS Dat$(2),Length(3) AS Dat$(3),Length(4) AS Dat$(4),Length(5) AS Dat$(5),Length(6) AS Dat$(6),Length(7) AS Dat$(7),Length(8) AS Dat$(8),Length(9) AS Dat$(9)
  240.       RecordNumber=1
  241. ReadLoop:
  242.     CLS : LOCATE 1,1 : COLOR 1,0 : PRINT  "Read Data"
  243.     LOCATE 1,25 : COLOR 3,0 : PRINT "File:";
  244.     COLOR 1,0 : PRINT Nam$
  245.     COLOR 3,0
  246.     LOCATE 17,1 : PRINT  "[Cursor UP]   = Previous Record"
  247.     LOCATE 17,37 : PRINT "[F1]      = First Record"
  248.     PRINT "[Cursor Down] = Next Record"
  249.     LOCATE 18,37 : PRINT "[F2]      = Last Record"
  250.     PRINT "[CTRL]-[P]    = Print Record"
  251.     LOCATE 19,37 : PRINT "[HELP]    = Alter Record"
  252.     PRINT "[F10]         = Main Menu";
  253.   ReadRecord:
  254.     COLOR 1,0
  255.     IF RecordNumber>NoOfRecords THEN BEEP : RecordNumber=NoOfRecords
  256.     IF RecordNumber<1 THEN BEEP : RecordNumber=1
  257.     LOCATE 1,50 : PRINT "Record:";RecordNumber
  258.     GET #1,RecordNumber
  259.     IF DataSearch=1 THEN LOCATE 1,1 : PRINT "Search Data" : GOSUB ExamSearchData
  260.     IF DataSearch=1 AND Found=0 THEN
  261.        IF RecordNumber=NoOfRecords THEN Direction=-1
  262.        IF RecordNumber=NoOfRecords AND FindRecord=0 THEN
  263.           CLS
  264.           LOCATE 5,10 : PRINT "No record found!"
  265.           LOCATE 7,10 : COLOR 3,0
  266.           PRINT  "Press any key."
  267.           COLOR 1,0 : BEEP
  268.           WHILE INKEY$="" : WEND : CLOSE 1 : GOTO Begin
  269.        END IF
  270.        IF RecordNumber=1 THEN Direction=1
  271.        RecordNumber=RecordNumber+Direction
  272.       GOTO ReadRecord
  273.     END IF
  274.     FindRecord=1
  275.     FOR x=0 TO NoOfFields
  276.       LOCATE 5+x,1 : COLOR 2,0 : PRINT Fieldname$(x)":  "
  277.     NEXT x : COLOR 1,0
  278.     FOR x=0 TO NoOfFields
  279.       LOCATE 5+x,LEN(Fieldname$(x))+3
  280.       PRINT  Dat$(x)
  281.       Entry$(x)=Dat$(x)
  282.     NEXT x
  283.     Key$=""
  284.     WHILE Key$="" : Key$=INKEY$ : WEND
  285.     IF Key$=CHR$(28) THEN RecordNumber=RecordNumber-1 : Direction=-1
  286.     IF Key$=CHR$(29) THEN RecordNumber=RecordNumber+1 : Direction=1
  287.     IF Key$=CHR$(129) THEN RecordNumber=1
  288.     IF Key$=CHR$(130) THEN RecordNumber=NoOfRecords
  289.     IF Key$=CHR$(138) THEN EndLoad
  290.     IF Key$=CHR$(16) THEN
  291.        FOR x=0 TO NoOfFields
  292.          LPRINT Fieldname$(x)":"Dat$(x)
  293.        NEXT x
  294.        LPRINT
  295.     END IF
  296.     IF Key$=CHR$(139) THEN DataFlag=1 : GOTO EnterCorrection
  297. GOTO ReadLoop
  298.  
  299. EndLoad:
  300.     CLOSE 1
  301.     Nam$=""
  302. GOTO Begin
  303.  
  304. REM ************** Subprogram *******************
  305.  
  306. SearchData:
  307.   CLS : LOCATE 1,1 : COLOR 1,0 : PRINT "Search Data"
  308.   LOCATE 1,25 : COLOR 3,0 : PRINT "File:";
  309.   COLOR 1,0 : PRINT Nam$
  310.   FOR x=0 TO NoOfFields
  311.     LOCATE 5+x,1 : PRINT Fieldname$(x)":"
  312.   NEXT x
  313.   COLOR 3,0 : LOCATE 4,1  
  314.   PRINT  "Enter search string."
  315.   COLOR 1,0
  316.     FOR x=0 TO NoOfFields
  317.       LOCATE 5+x,LEN(Fieldname$(x))+2
  318.       LINE INPUT Entry$
  319.       IF Entry$<>"" THEN
  320.         Search$=LEFT$(Entry$,Length(x))
  321.         SearchNo=x : x=10
  322.       ELSE
  323.         Search$=""
  324.       END IF
  325.     NEXT x
  326.   Corrections3:
  327.      GOSUB EntryOK
  328.     IF Corr=0 THEN EndSearch
  329.     IF Corr=1 THEN SearchCorr
  330.   GOTO Corrections3
  331.  
  332.   SearchCorr:
  333.     LOCATE 5+SearchNo,1 : PRINT Fieldname$(SearchNo)":"Search$
  334.     LOCATE 5+SearchNo,LEN(Fieldname$(SearchNo))+2
  335.     LINE INPUT Entry$
  336.     IF Entry$<>"" THEN Search$=LEFT$(Entry$,Length(SearchNo))
  337.   GOTO Corrections3
  338.   
  339. EndSearch:
  340.   IF Search$="" THEN SearchNo=0 : DataSearch=0
  341.   FindRecord=0
  342. RETURN
  343.  
  344. ExamSearchData:
  345.     x=0
  346. SearchLoop:
  347.     x=x+1
  348.     IF x>LEN(Dat$(SearchNo))-LEN(Search$) THEN Found=0 : RETURN
  349.     IF MID$(Dat$(SearchNo),x,LEN(Search$))=Search$ THEN Found=1 : RETURN  
  350. GOTO SearchLoop  
  351.  
  352. EntryOK:
  353.   LOCATE 19,1 : COLOR 3,0
  354.   PRINT "Entry Okay? (Y/N)";
  355.   COLOR 1,0 : INPUT "",a$
  356.   IF UCASE$(a$)="Y" OR a$="" THEN Corr=0 : RETURN
  357.   IF UCASE$(a$)="N" THEN Corr=1 : RETURN
  358. GOTO EntryOK
  359.  
  360. FieldFileExistYN:
  361.   OPEN Nam$+".Flds" FOR APPEND AS 1
  362.     IF LOF(1)<=0 THEN FileExist=0 ELSE FileExist=1
  363.   CLOSE 1
  364.   IF FileExist=0 THEN
  365.     LOCATE 3,1 : PRINT  SPACE$(60) : BEEP
  366.     LOCATE 3,1 : COLOR 1,0 : PRINT "File ";Nam$
  367.     PRINT "not found!"
  368.     KILL Nam$+".Flds"
  369.     Nam$="" : COLOR 3,0
  370.   END IF
  371. RETURN
  372.  
  373. ReadFileField:
  374.   FOR x=1 TO 10
  375.     Fieldname$(x)="" : Length(x)=0
  376.   NEXT x
  377.   OPEN Nam$+".Flds" FOR INPUT AS 2
  378.     INPUT #2,NoOfFields
  379.     INPUT #2,RecordLength
  380.     INPUT #2,NoOfRecords
  381.     FOR x=0 TO NoOfFields
  382.       INPUT #2,Fieldname$(x)
  383.       INPUT #2,Length(x)
  384.     NEXT x
  385.   CLOSE 2
  386. RETURN
  387.